;;;
;;; JaCoLiB
;;; Copyright (C) 2008 Alessandro Serra
;;; 
;;; This program is free software: you can redistribute it and/or modify
;;; it under the terms of the GNU General Public License as published by
;;; the Free Software Foundation, either version 3 of the License, or
;;; (at your option) any later version.
;;; 
;;; This program is distributed in the hope that it will be useful,
;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;;; GNU General Public License for more details.
;;; 
;;; You should have received a copy of the GNU General Public License
;;; along with this program.  If not, see <http://www.gnu.org/licenses/>.
;;;

;;;; Created on 2008-07-21 14:36:25

(in-package :jacolib)

;
; Connection Manager
;

(defclass rpc-connection ()
  ((connection
    :TYPE connection
    :ACCESSOR rpc-connection-connection
    :INITARG :connection)
   (rpc-channel
    :TYPE rpc-channel
    :ACCESSOR rpc-connection-rpc-channel
    :INITARG :rpc-channel))
  (:documentation "Manages the rpc system based over a sokect connection."))

; initializer

(defmethod initialize-instance :after ((rpc-connection rpc-connection) &rest initargs)
  (declare (ignore initargs))
  (rpc-channel-set-exec-handler (rpc-connection-rpc-channel rpc-connection) 
                          #'(lambda (x)
                              (connection-send-request (rpc-connection-connection rpc-connection) x)
                              (rpc-connection-loop-until-response rpc-connection)))
  (rpc-channel-set-quit-handler (rpc-connection-rpc-channel rpc-connection) 
                                #'(lambda ()
                                    (connection-close (rpc-connection-connection rpc-connection)))))

; loop functions

(defun rpc-connection-step (channel)
  (multiple-value-bind (r obj) (connection-receive (rpc-connection-connection channel))
    (cond
     ((eq r 'request)
      (handler-case
       (connection-send-response (rpc-connection-connection channel)
                                 (rpc-server-stub-exec (rpc-channel-server-stub (rpc-connection-rpc-channel channel)) obj))
       (error(x) 
         (progn
           (connection-send-fatalerror-and-quit (rpc-connection-connection channel) (format nil "Remote error: ~A" x))
           (error x)))))
     ((eq r 'fatal-error)
      (error 'protocol-error :message obj))
     (t
      (values r obj)))))

(defun rpc-connection-loop-until-response (channel)
  (let ((res (loop
              (multiple-value-bind (r obj) (rpc-connection-step channel)
                (if (eq r 'response)
                    (return obj))
                (if (eq r 'close)
                    (error 'protocol-error :message "Connection unexpectly closed"))))))
    res))

(defun rpc-connection-loop-until-quit (channel) 
  (loop
   (let ((r (rpc-connection-step channel)))
     (if (eq r 'close)
         (progn
           (rpc-channel-quit% (rpc-connection-rpc-channel channel))
           (setf (slot-value channel 'connection) nil)
           (setf (slot-value channel 'rpc-channel) nil)
           (return))))))

